perm filename SUB[E,ALS] blob sn#257785 filedate 1977-01-12 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	SUBSTR SUBST1 SUBOVE SUBST5 QFAST1 QFAST5 SUBSAY QFAST6 QFAST9
C00009 ENDMK
CāŠ—;
;SUBSTR SUBST1 SUBOVE SUBST5 QFAST1 QFAST5 SUBSAY QFAST6 QFAST9
SUBSTR:	PUSHJ P,ENDSET
	TLO F,NOCHK
	HRRZ H,FSEND
	ADDI H,1
	MOVE I,ARRLIN		;Set by SETARR to line for action
	MOVE E,SAVEE		;This may have been changed
	SETZB B,G
	HLLZ Q,TXTFLG(I)
LEG	HLLZM Q,TXTFLG(H)
	MOVEM H,ARRLIN
	TLNE Q,WINBIT
	MOVEM H,WINLIN
	MOVE A,I
	MOVE TT,(A)
LEG	MOVEM TT,(H)
	HLRZ T,TT
	HRRM H,(T)
	CAIN T,PAGE
	TRO F,UPDTXT
	HRLM H,(TT)
	AOS TT,TXTNUM
LEG	HRRM TT,TXTSER(H)
	MOVEM TT,SRCNUM			;This will have been changed
	ADD A,[440700,,LLDESC]	;Location where text starts
	MOVE D,H
	ADD D,[440700,,LLDESC]
	MOVEI Q,SUBBUF(E)	;Substitution text location
	ADD Q,[440700,,0]
	HRRE T,SRCOFF		;Character position to start deletion
	JUMPLE T,SUBST1		;Substitution starts with the first character
	ILDB C,A
LEG	IDPB C,D		;Copy text to deletion point
	CAIN C,11
	PUSHJ P,SUBTAB		;We must do this to get G and B set right
	AOS B
	SOJG T,.-5
SUBST1:	HLRZ T,SUBSIZ(E)	;Get count of text to delete
	MOVEM A,ASAVE
SUBST0:	ILDB C,A		;Index over replaced text
	CAIN C,15
	JRST SUBOVE 		;Not allowed at present
	CAIN C,11		;TABs require special treatment
	PUSHJ P,EATTAB
	SOJG T,SUBST0		;Count deletions
	HRRZ T,SUBSIZ(E)	;Length of substitution string is here
	JUMPE T,SUBST3		;The null substitution case
SUBST2:	ILDB C,Q
LEG	IDPB C,D
	CAIN C,11
	PUSHJ P,FIXTAB		;Must fix TAB representation (note skip return)
	AOS B
	SOJG T,SUBST2		;Count insertions
SUBST3:	ILDB C,A		;Get rest of original text
	CAIN C,15		;Watch for the CR
	JRST SUBST4
LEG	IDPB C,D
	CAIN C,11
	PUSHJ P,SUBTAB		;Do proper thing for TABs (note skip return)
	AOS B
	JRST SUBST3		;Go on anyway, test comes later

EATTAB:	ILDB C,A		;Eat all blanks to the next TAB
	CAIE C,11
	JRST .-2
	POPJ P,
	
;This routine eats old spaces associated with tabs and puts in the correct number.
;It also keeps the correct records in G and B.
SUBTAB:	ILDB C,A
	CAIE C,11		;First eat all old spaces
	JRST .-2
FIXTAB:	ADDI G,(B)
	HRLI B,(B)
	TLO B,-10
	MOVEI TT,40
LEG	IDPB TT,D		;Insert correct number of spaces
	AOBJN B,.-1
	SUBI G,-1(B)
LEG	IDPB C,D		;Deposit terminating TAB
	AOS (P)			;Skip return as we have already updated B enough
	POPJ P,

;Substitution for CR not allowed
SUBOVE:	MOVE A,ASAVE		;Back up to start of deletion
	SOS QCHR		;So count will be correct
	SOS SUBFLG(E)
	OUTSTR [ASCIZ/
Replacing a CR (line /]
	SETZM TYOPNT
	TYPDEC ARRL
	OUTSTR [ASCIZ/, page /]
	TYPDEC CURPAG
	OUTSTR [ASCIZ/) is not allowed. Do you want to stop?  /]
	PUSHJ P, YESCHK
	HRRZS QCHR
	JRST SUBST3

;We have come to the end of the line
SUBST4:	HRRZ T,B		;Are there be any chars left?
	JUMPN T,SUBST5		;Yes
	MOVEI T,40		;Need at least 1 char
LEG	IDPB T,D
	TLO F,NULLIN		;No text in this line
SUBST5:
LEG	IDPB C,D		;Now the CR
	MOVEI C,12
LEG	IDPB C,D
	TDZA C,C		;Set C to zero and skip
LEG	IDPB C,D
	TLNE D,760000
	JRST .-2		;Pad out with nulls
;Text must be in ASCID
	MOVEI T,LLDESC(H)
	MOVEI TT,1
	IORM TT,(T)
	CAIGE T,(D)
	AOJA T,.-2
;Now we must give up the space originally used by the line
QFAST1:	HLRZ T,TXTCNT(I)
	MOVNI T,(T)			;and do 1's complement of T
	ADDM T,CHARS
;Add to CHARS, fix TXTCNT
	ADDI G,2(B)		;Allow for CR and LF in G count
	ADDM G,CHARS		;Previously debited by the number in original line
	HRLZS G
	IORI G,(B)
LEG	MOVEM G,TXTCNT(H)
	MOVEI TT,2(D)
	MOVSI T,TXTCOD			;A fancy way to store 2 in left half!
	FSFIX TT,T
	PUSHJ P,ENDFIX
	MOVE A,I
	PUSHJ P,FSGIVE			;Give up storage space.
	TLZ F,NOCHK
QFAST6:	PUSHJ P,SETWRT			;May need attention
	HRRZ TT,SUBSIZ(E)
	ADD TT,SRCOFF
	SUBI TT,1
	HRRZM TT,SRCOFF			;Move to last character of substitution
;Update count and test for continuance
	MOVE TT,QCHR
	AOBJP TT,QFAST4
	MOVEM TT,QCHR
	MOVEM TT,SUBFLG(E)
QFAST7:	TRZ F,ARG!REL
	TLZ F,OKF
	CAIN E,FNDBUF
	JRST FINBSL		;Go to the X routine
	JRST FNDBSL		;Go to the page-only routine

QFAST4:	JUMPE TT,QFAST5
QFAST9:	PUSHJ P,ABCRL0		;Type CRLF, preserving ACs
	OUTSTR [ASCIZ /As requested, /]
	AOS SUBFLG(E)
	MOVE B,SDATA
	ADDI B,SRCBUF
	JRST SUBSTP		;To report on actual number replaced

QFAST5:	SETZM QCHR		;Have done 1 substitution
SUBSAY:	PUSHJ P,ABCRL0		;Type CRLF preserving ACs.
	OUTSTR [ASCIZ /You have replaced \/]
	MOVE B,SDATA
	ADDI B,SRCBUF
	JRST SUBSP3